home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / database / dmetclip / terminal.prg < prev   
Text File  |  1991-05-10  |  15KB  |  458 lines
  1. ***********************  TERMINAL.PRG  ****************************************
  2. *
  3. * This version runs under:  CLIPPER Summer 87 & 5.0
  4. *                          -------------------------
  5. *
  6. * This is a sample program which demonstrates a number of the COMETMP library
  7. * commands used to emulate a simple terminal program.
  8. *
  9. * Command keys while in TERMINAL:
  10. *   F2 - Clears the screen
  11. *   F3 - Send a file or group of files(if Ymodem specified for protocol)
  12. *   F4 - Receive a file or files(if Ymodem)
  13. *   ESC - Exits TERMINAL program or CANCEL an active file transfer
  14. *******************************************************************************
  15. *
  16. SET BELL OFF
  17. SET STATUS ON
  18. SET SCOREBOARD OFF
  19. SET SAFETY OFF
  20. PUBLIC Event, LF, Msg, ChkCmd, Thresh, Fox, FoxPro, LastMsg, TranHow
  21. PUBLIC ComPort, ComAddr, ComIRQn, ComBaud, ComPrty, ComDBts, ComFlow, ComPhon
  22. PUBLIC NKey
  23. TranHow = ' '
  24.  
  25. CLEAR
  26.  
  27. Vers = 'VERS' + SPACE(15)
  28. CALL COMETMP WITH Vers              && Get version #
  29. Vers = SUBSTR(Vers, 6)              && Strip off "VERS " leaving only version info
  30.  
  31. * Display sign-on message
  32. @ 5, 13 TO 13,65 DOUBLE
  33. @ 7,15 SAY 'TERMINAL - A Terminal Emulation Program Using ...'
  34. @ 9,28 SAY '*** ' + Vers + ' ***'
  35. @ 11,15 SAY 'The  B A C K G R O U N D  Communication Library'
  36. Msg = 'COPYRIGHT(c) 1989-91 by  CompuSolve,  Rockaway, NJ  (201)983-9429'
  37. DO ShowOn24 WITH Msg
  38.  
  39. INKEY(5)
  40. CLEAR
  41.  
  42. * Get default settings from TERMINAL.MEM file, if present
  43. IF FILE('TERMINAL.MEM')
  44.  RESTORE FROM TERMINAL ADDITIVE
  45. ELSE
  46.  ComPort = '1'
  47.  ComAddr = 'x03F8'
  48.  ComIRQn = '4'
  49.  ComBaud = '2400 '
  50.  ComPrty = 'E'
  51.  ComDBts = '7'
  52.  ComStop = '1'
  53.  ComFlow = 'N'
  54. *
  55.  ComPhon = SPACE(20)
  56. ENDIF
  57.  
  58. DO ShowOn24 WITH "ENTER DESIRED COM PORT SETTINGS ..."
  59. @ 6,8 TO 15, 72
  60. @ 7,10 SAY 'COM Port # (1-5) ?' GET ComPort PICTURE '9'
  61. @ 8,10 SAY "I/O Address (x#### = heX) ?" GET ComAddr
  62. @ 9,10 SAY "IRQ # (2-7) ?" GET ComIRQn PICTURE '9'
  63. @10,10 SAY "BAUD Rate (300-38400) ?" GET ComBaud PICTURE 'X9999'
  64. @11,10 SAY "Parity (None, Odd or Even) ?" GET ComPrty PICTURE '!'
  65. @12,10 SAY "# Data Bits (7 or 8) ?" GET ComDBts PICTURE '9'
  66. @13,10 SAY "Flow Control (Xon/xoff, Rts/cts or None) ?" GET ComFlow PICTURE "!"
  67. @14,10 SAY "# Stop Bits (1 or 2) ?" GET ComStop
  68. READ
  69.  
  70. RKey = READKEY()
  71. IF MOD(RKey,256) = 12    && ESCape 
  72.   QUIT
  73. ENDIF
  74.  
  75. Msg = 'Enter a telephone # to dial (ENTER = local mode) ?'
  76. DO ShowOn24 WITH Msg
  77. @0,0
  78. * Init variables
  79. ChkCmd = ''
  80.  
  81. * Function keys used to invoke local commands
  82. F1 = 28
  83. F2 = -1                             && Clear Screen
  84. F3 = -2                             && Send file
  85. F4 = -3                             && Receive file
  86. F5 = -4
  87.  
  88. Up = 5
  89. Dn = 24
  90. Rgt = 4
  91. Lft = 19
  92. BkSpc = 127
  93.  
  94. * Build OPEN command for COMET
  95. Open = "OPEN COM" + ComPort + "," + ComAddr + "," + ComIRQn + ":" ;
  96.  + ComBaud + "," + ComPrty + "," + ComDBts + ",1," + ComFlow
  97.  
  98. ClsPort = 'CLOSE #' + ComPort          && In case port is being redefined ...
  99. CALL COMETMP WITH ClsPort
  100.  
  101. CALL COMETMP WITH Open                && Now OPEN it for use, that was easy!
  102.  
  103. * Now we'll dial a phone#
  104. * Request # to dial 1st
  105. PhoneNo = SPACE(20)
  106. @16,10 SAY "Phone # to Dial (ENTER = direct/local) ?" GET ComPhon
  107. READ
  108.  
  109. *Save settings
  110. SAVE TO TERMINAL ALL LIKE Com????
  111.  
  112.  
  113. IF LEN(TRIM(ComPhon)) > 0
  114.  
  115.  * Issue Hayes modem setup commands
  116.  StUp1 = "OUTPUT #" + ComPort + ",ATQ0V1&C1&D2&W0" + CHR(13)
  117.  CALL COMETMP WITH StUp1
  118.  INKEY(1)
  119.  StUp2 = "OUTPUT #" + ComPort + ",ATZ" + CHR(13)
  120.  CALL COMETMP WITH StUp2
  121.  INKEY(1)
  122.  
  123.  * The ATTD is output to instruct HAYES compatible modems to dial a #
  124.  Dial = "OUTPUT #" + ComPort + ",ATTD" + TRIM(ComPhon) + CHR(13)  && Build OUTPUT command
  125.  CALL COMETMP WITH Dial                && Have modem dial #
  126.  
  127.  * Now, wait till we sense Data Carrier Detect(DCD) from our COM port.
  128.  Msg = "CHECKING FOR MODEM'S DATA CARRIER DETECT (DCD) ..."
  129.  DO ShowOn24 WITH Msg
  130.  Elapsed = 0                         && Simple timer for our DO .. WHILE loop
  131.  LastTime = TIME()                   && Also used for timing purposes
  132.  MdmStat = "MSTAT #" + ComPort + "," + SPACE(25)        && Build MSTAT command
  133.  DO WHILE Elapsed <= 45  .AND. (.NOT. "+DCD" $ MdmStat)
  134.     CALL COMETMP WITH MdmStat         && Get COM port's modem status
  135.  
  136.     IF LastTime <> TIME()           && Test if we need to updated timer count
  137.         Elapsed = Elapsed+1         && Another second has gone by ..
  138.         LastTime = TIME()
  139.         @ 24, 66 SAY STR(45-Elapsed,2,0)  && Display #secs till abort
  140.     ENDIF
  141.  
  142.    IF INKEY() = 27
  143.      EXIT
  144.    ENDIF
  145.  
  146.  ENDDO
  147.  
  148.  * Check if we timed out
  149.  IF Elapsed > 45
  150.     ??CHR(7)
  151.     DO ShowOn24 WITH "Sorry, can't establish phone connection. Aborting ..."
  152.     QUIT
  153.  ENDIF
  154.  
  155. ENDIF                       && If phone # was entered
  156.  
  157.  
  158.  
  159. * Now that we have a call established we have 2 things to do:
  160. *  1) Check COMETMP's receive buffer and display any incoming characters
  161. *  2) Detect any keystrokes and determine if local command or data to output
  162.  
  163. * #2 is simple, use an ONKEY approach
  164.  
  165.  
  166. CLEAR
  167.  
  168. * Display status message on line 24
  169. Msg = "F2 - Clear | F3 - Send | F4 - Recv | TERM"
  170. LastMsg = Msg
  171. DO ShowOn24 WITH Msg
  172.  
  173. OFLOW = ' '
  174.  
  175.  
  176. ***************************************************************************
  177. * This is main loop for testing for and displaying any incoming data
  178. * and checking for keypress
  179.  
  180. DO WHILE .T.
  181.     OurKey = INKEY()           && Look for a key press
  182.     IF OurKey <> 0
  183.         DO GotAKey WITH OurKey
  184.     ENDIF
  185.  
  186.     NoColsLft = 79 - COL()
  187.     Inp = "INPUT #" + ComPort + ",?????"  + SPACE(NoColsLft) + CHR(10)  && Build INPUT command
  188.     CALL COMETMP WITH Inp   && Read COMET's COM port data buffer
  189.  
  190.     AmtRetd = VAL(SUBSTR(Inp,10,5))  && Determine how many chars were returned, if any
  191.     COMactive = IIF(AmtRetd > 0, .T., .F.)
  192.  
  193.     IF AmtRetd > 0
  194.       ComData = SUBSTR(Inp, 15, AmtRetd)  && Get just the COM data from <expC>
  195.       ?? ComData
  196.       IF ROW() > 23
  197.          SCROLL(0,0,23,79,1)
  198.          @23, 0
  199.       ENDIF
  200.     ENDIF
  201.  
  202.  ENDDO
  203.  
  204. ***************************************************************************
  205.  
  206. ***************************** GotAKey *************************************
  207. * Anytime a key gets pressed, we jump here
  208. *
  209. PROCEDURE GotAKey
  210. PARAMETERS Key
  211.  
  212.  
  213. DO CASE                     && Decide whether key is data to output or local command
  214.     CASE Key > 0 .AND. Key <> 27    && data to output ?
  215.         IF .NOT. 'ACTIVE' $ ChkCmd .OR. TranHow = 'A'   && Output if: no xfers active  OR  ASEND/ARECV active
  216.             Output = "OUTPUT #" + ComPort + "," + CHR(Key)   && Build OUTPUT command
  217.             CALL COMETMP WITH Output          && Output char to COM port
  218.         ELSE
  219.             CLEAR
  220.             ?? CHR(7)
  221.             @ 4,0 TO 12,79 DOUBLE
  222.             @ 6,2 SAY "Sorry but we're busy " + event + "ing a file now!"
  223.             @ 7,2 SAY "But, that fact that I can display this alert box "
  224.             @ 8,2 say "proves COMET is running in the background."
  225.             @ 9,2 say "Hit the 'D' key and I'll do a !DIR command in DOS."
  226.             @10,2 say "Hit any key ..."
  227.             * Wait loop using INKEY(n) if FoxBase+ otherwise Do .. While
  228.             Ky = INKEY(5)
  229.             IF ky = ASC('D') .OR. ky = ASC('d')
  230.                 !DIR
  231.             ENDIF
  232.         ENDIF
  233.  
  234.     CASE Key = 27           && ESC hit ?
  235.         IF 'ACTIVE' $ ChkCmd        && File transfer active ?
  236.             FlshPort = 'FLUSH #' + ComPort
  237.             CALL COMETMP WITH FlshPort && If so, user wants to cancel it
  238.         ELSE
  239.             CALL COMETMP WITH 'ONTIME '
  240.             QUIT             && If no active file transfer, then quit
  241.         ENDIF
  242.     OTHERWISE                   && If INKEY() < 0, then a function key was hit
  243.         DO Local
  244. ENDCASE
  245.  
  246.  
  247. RETURN
  248.  
  249.  
  250. ****************************** Local ***************************************
  251. * Support for function keys (ie. local commands like send and receive)
  252. PROCEDURE Local
  253.  
  254. DO CASE
  255.     CASE Key = F2               && Clear screen ?
  256.         CLEAR
  257.         DO ShowOn24 WITH Msg
  258.     CASE Key = F3               && Send file ?
  259.         DO TranFile WITH 'SEND'
  260.     CASE Key = F4               && Receive file ?
  261.         DO TranFile WITH 'RECV'
  262.     CASE Key = F5              && ONTIME command requesting STATUS update ?
  263.         DO Status
  264. ENDCASE
  265.  
  266. RETURN
  267.  
  268. ************************ TranFile *******************************************
  269. PROCEDURE TranFile
  270. PARAMETERS Action
  271. IF 'ACTIVE' $ ChkCmd        && We're good, but not that good that we can have two transfers simultaneously!
  272.     Msg = 'Request denied !  There is a file transfer ACTIVE'
  273.     DO ShowOn24 WITH Msg
  274.     INKEY(3)
  275.     Msg = LastMsg
  276.     DO ShowOn24 WITH Msg
  277.     RETURN
  278. ENDIF
  279.  
  280. ExitFlg = .F.
  281. SAVE SCREEN
  282. SET COLOR TO N/W
  283. @ 6,5 CLEAR TO  12,75
  284. @ 6,5 TO 12,75
  285. SET COLOR TO N/W, W/N
  286.  
  287.  
  288. * Prompt for transfer protocol desired (Ascii, Xmodem, Xmodem-1K or Ymodem)
  289. * We don't use a VALID clause since DBASE doesn't support
  290. TranHow = '  '
  291. DO ShowOn24 WITH "CHOOSE FILE PROTOCOL: A=Ascii, X=Xmodem, X1=Xmodem(1K) or Y=Ymodem"
  292. DO WHILE .NOT. (ExitFlg .OR. ALLTRIM(TranHow) $ 'AX1Y')
  293.     @ 8, 6 SAY 'Protocol(A,X,X1 or Y) ?' GET TranHow PICTURE '@! A9'
  294.     READ                            && Get protocol
  295.     ExitFlg = IIF(READKEY()=12 .OR. READKEY()=268, .T., ExitFlg)
  296.     ?? IIF(.NOT. ALLTRIM(TranHow) $ 'AX1Y', CHR(7), '')   && Beep if invalid
  297. ENDDO
  298.  
  299. TranHow = ALLTRIM(TranHow)
  300.  
  301. * Prompt for filename except for YRECV since filename gets transmitted w/data
  302. TranFil = SPACE(40)
  303. IF .NOT. ExitFlg .AND. (TranHow <> 'Y' .OR. Action = 'SEND')
  304.     DO ShowOn24 WITH "ENTER FILENAME TO " + IIF(Action = 'RECV', 'RECEIVE', 'SEND')
  305.     @ 8, 35 SAY 'Filename ?' GET TranFil PICTURE '@S30'
  306.     READ
  307.     ExitFlg = IIF(READKEY()=12 .OR. READKEY()=268, .T., ExitFlg)
  308. ENDIF
  309.  
  310. * Prompt for timeout in seconds if ARECV, default is 60 secs
  311. TimeOut = 60
  312. IF .NOT. ExitFlg .AND. TranHow = 'A' .AND. Action = 'RECV'
  313.     DO ShowOn24 WITH "ENTER RECEIVER IDLE TIME IN SECONDS BEFORE AUTO-CLOSING OF FILE"
  314.     @ 10, 26 SAY 'ARECV timeout in seconds ?' GET TimeOut PICTURE "999"
  315.     READ
  316.     ExitFlg = IIF(READKEY()=12 .OR. READKEY()=268, .T., ExitFlg)
  317. ENDIF
  318.  
  319. SET COLOR TO W/N, N/W
  320. RESTORE SCREEN
  321.  
  322.  
  323. IF ExitFlg                    && Look for ESC key
  324.     RETURN
  325. ENDIF
  326.  
  327. *Now build COMETMP SEND or RECV command
  328. TranCmd = TranHow + Action + ' #' + ComPort + ',' + TRIM(TranFil)
  329. IF 'ARECV' $ TranCmd .AND. TimeOut <> 60 && Test if we need ARECV timeout option
  330.     TranCmd = TranCmd + ',' + STR(TimeOut,3,0)
  331. ENDIF
  332.  
  333.   * If X/YModem, port must be set to 8 data bits/No parity
  334. IF TranHow # 'A'        && ASCII file xfer?
  335.   DBits7 = AT(',7,', Open)              && Currently OPENed for 7 data bits ?
  336.  IF DBits7 > 0
  337.   OpnN8 = STUFF(Open,DBits7-1,3,"N,8")  && Create modified version of original Open
  338.   CALL COMETMP WITH OpnN8
  339.  ENDIF
  340. ENDIF
  341.  
  342. * Issue command to COMETMP
  343. CALL COMETMP WITH TranCmd         && Startup background file transfer
  344.  
  345. *Check that file transfer was able to start
  346. ChkCmd = 'FCHK #' + TRIM(ComPort) + ',' + SPACE(80)
  347. CALL COMETMP WITH ChkCmd
  348. IF .NOT. 'ACTIVE' $ ChkCmd       && Should be active if command started!
  349.     LBracAt = AT('[',ChkCmd)     && Find start of FCHK failure description, if any
  350.     IF LBracAt > 0               && If [ present, we have a failure description
  351.         RBracAt = AT(']', ChkCmd)  && Find ] which is end of description
  352.         Reason = SUBSTR(ChkCmd, LBracAt+1, RBracAt-LBracAt-1)
  353.     ELSE
  354.         Reason = 'GENERAL ERROR'
  355.     ENDIF
  356.     ?? CHR(7)                    && If wasn't successful at starting SEND, alert operator
  357.     Msg = LEFT(Msg,37) + Action + ' Command Failed - ' + Reason
  358.     DO ShowOn24 WITH Msg
  359.     INKEY(3)
  360.     Msg = LastMsg
  361.     DO ShowOn24 WITH Msg
  362.     CALL COMETMP WITH Open        && Restore original COM port OPEN params
  363.     RETURN
  364. ENDIF
  365.  
  366. Event = TranHow + Action            && This will be used by Status procedure
  367. Thresh = 0
  368. DO Status
  369.  
  370. *File Send or Recv in progress, now use ONTIME command to update status every 3 secs
  371. *STATUS procedure will now execute every 5 seconds
  372. OnTime = 'ONTIME 5,0,63'        && #secs=5, ASCII cd=0 , Aux Byte=63 (F5 key)
  373. CALL COMETMP WITH OnTime
  374.  
  375. RETURN                          && All done, returns back to Local proc
  376.  
  377.  
  378. *************************** Status ************************************
  379. * F10 key or COMETMP's ONTIME command brings us here
  380. * Updates bottom line on screen with file transfer status
  381. *
  382. PROCEDURE Status
  383. PRIVATE CurR, CurC
  384.  
  385. CurR = ROW()            && Save cursor loc
  386. CurC = COL()
  387.  
  388. ChkCmd = 'FCHK #' + TRIM(ComPort) + ',' + SPACE(80)
  389. CALL COMETMP WITH ChkCmd          && Get current file transfer status
  390.  
  391.  * Now extract the status info we want; FCHK's status, size and filename
  392. FCHKstat = SUBSTR(ChkCmd,25,8)  && Status - ACTIVE, COMPLETE or FAILED
  393. FCHKsize = SUBSTR(ChkCmd,34,7)  && Size in bytes - #######
  394. FCHKfile = SUBSTR(ChkCmd,42)    && Filename - path\filename (variable length)
  395.  
  396. * Adjust filename if necessary
  397. SpcAt = AT(' ',FCHKfile)        && Look for end of path\filename
  398. FCHKfile = IIF(SpcAt > 0, SUBSTR(FCHKfile,1,SpcAt-1), FCHKfile)
  399. FCHKfile = IIF(LEN(FCHKfile) > 12, RIGHT(FCHKfile,12), FCHKfile)
  400.  
  401. * Append failure description to FCHKstat - if FAILED
  402. IF 'FAILED' $ FCHKstat
  403.     LBracAt = AT('[',ChkCmd)     && Find start of FCHK failure description, if any
  404.     RBracAt = AT(']', ChkCmd)  && Find ] which is end of description
  405.     Reason = SUBSTR(ChkCmd, LBracAt+1, RBracAt-LBracAt-1)
  406.     FCHKstat = FCHKstat + Reason
  407.     FCHKfile = ""               && Need the room to display failure description
  408. ENDIF
  409.  
  410.  
  411. OFLOW = IIF(OFLOW = '*' .OR. 'DATA LOSS' $ ChkCmd, '*', ' ')
  412.  
  413. * Display extracted status
  414. *Msg = LEFT(Msg,37) + Event + ' | ' + FCHKstat + ' | ' + FCHKsize + ' | ' + FCHKfile
  415. Msg = LEFT(Msg,37) + Event + ' | ' + FCHKstat + ' | ' + FCHKsize + ' |' + OFLOW  + FCHKfile
  416. DO ShowOn24 WITH Msg
  417.  
  418. IF .NOT. 'ACTIVE' $ ChkCmd    && COMPLETEd or FAILED ?
  419.     Thresh = Thresh + 1
  420.     IF Thresh > 1               && Don't want to redisplay old stat msg till 1 cycle
  421.         Ontime = 'ONTIME'
  422.         CALL COMETMP WITH Ontime      && If so, turn off timer event trapping
  423.         Msg = LastMsg
  424.         DO ShowOn24 WITH Msg
  425.     ELSE
  426.  
  427.         ?? CHR(7)               && Call attention to COMPLETE or FAILED status
  428.         IF TranHow # 'A'
  429.             CALL COMETMP WITH Open        && Restore original COM port OPEN params
  430.         ENDIF
  431.         
  432.     ENDIF
  433. ENDIF
  434.  
  435. @ CurR, CurC SAY ''
  436.  
  437. RETURN
  438.  
  439. * Displays a message centered on last line in reverse video
  440. PROCEDURE ShowOn24
  441. PARAMETERS MsgToOut
  442. PRIVATE RRow, RCol
  443.  
  444. RRow = ROW()
  445. RCol = COL()
  446.  
  447. MsgLn = LEN(MsgToOut)
  448. NoToPad = INT((80-MsgLn)/2)
  449. Spcs = SPACE(NoToPad)
  450. SET COLOR TO N/W
  451. @ 24,0
  452. @ 24,0 SAY Spcs + MsgToOut
  453. SET COLOR TO W/N
  454.  
  455. @ RRow, RCol SAY ''
  456.  
  457. RETURN
  458.